home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / glib19.zip / MFEDDEMO.BAS < prev    next >
BASIC Source File  |  1991-06-27  |  21KB  |  683 lines
  1. '      FED - DEMO
  2. '  Version III - demonstrates the use of a LEVEL parameter
  3. '                to handle an entire record I/O in a loop and
  4. '                one or 2 MFed CALLS - NO GOTOs!!!!!
  5. '
  6. '                Note that Macros are not actually used, just the
  7. '                editting features of it.
  8. '
  9. '  Text input demo
  10. '  Demonstrates the use of MFed and several other GLib routines
  11. '
  12. '  Author: Gizmo Mike
  13. '  (C) InfoSoft, 1987, 1988, 1989
  14. '
  15.  
  16.  
  17. ' define named common block for most FED variables
  18. '
  19. DECLARE FUNCTION MFed% (ed$, fsiz%, Macro$())
  20. DECLARE FUNCTION ArgCnt%
  21. DECLARE FUNCTION ArgVar$ (which%)
  22. DECLARE FUNCTION NFrmat% (nst$, m%, p%)
  23. DECLARE FUNCTION DlrFrmat% (nst$, m%, p%)
  24.  
  25. COMMON SHARED /MFedVars/ fg%, bg%, fgd%, bgd%, Alarm%, bad$, editted%, hatch%, nums%, num$, upcase%, Mac%, RngLo#, RngHi#
  26.  
  27. DECLARE SUB SaveScrn (SEG arry%)
  28. DECLARE SUB RestScrn (SEG arry%)
  29.  
  30.  
  31.     CLEAR
  32.     DEFINT A-Z
  33.     OPTION BASE 1
  34.  
  35.     hatch = 176                         ' define hatching character
  36.     Mac = 0                             ' signal macros not used
  37.  
  38.  
  39.     TYPE structure                      ' set up employee structure
  40.        NName AS STRING * 25
  41.        Phone AS STRING * 8
  42.        Addr AS STRING * 25
  43.        City AS STRING * 10
  44.        State AS STRING * 2
  45.        Zip AS STRING * 5
  46.        Dept AS STRING * 6
  47.        Superv AS STRING * 12
  48.        PFreq AS STRING * 1
  49.        PRate AS SINGLE
  50.        PIN AS INTEGER
  51.     END TYPE
  52.  
  53.     DIM Emp AS structure             ' DIM emp as TYPE struct
  54.  
  55.     REDIM a$(11)                     ' temp holding for emp structures
  56.  
  57.     'make sure it is set up right
  58.     CLS : SOUND 750, 2: LOCATE 5, 5
  59.     PRINT "Depending on your display, you may want to restart this demo"
  60.     LOCATE 7, 5
  61.     PRINT "with the command line parameter [/CMD /NC] or [/CMD /C]. /NC for"
  62.     LOCATE 9, 5
  63.     PRINT "No Color, /C for color version."
  64.     LOCATE 13, 5
  65.     PRINT "Tap `S' to stop the demo, any other key to continue."
  66.  
  67.     GOSUB WaitKey
  68.  
  69.     IF ky$ = "S" OR ky$ = "s" THEN
  70.        SYSTEM
  71.     END IF
  72.  
  73.     '*********** get command line parms and set colors
  74.     q% = ArgCnt
  75.  
  76.     CMode = 1                           ' assume color
  77.     FOR x = 1 TO q
  78.     IF UCASE$(ArgVar$(x)) = "/NC" THEN
  79.         CMode = 0                   ' user wants no color
  80.         EXIT FOR
  81.     END IF
  82.     NEXT x
  83.  
  84.     IF CMode THEN                       ' find out if command line wants color
  85.     fg = 2: bg = 0                    ' general colors
  86.     fge = 12: bge = 3                 ' err message colors
  87.     fgw = 14: bgw = 4                 ' window colors
  88.     fgd = 10: bgd = 0                 ' data colors
  89.     fgh = 15: bgh = 1                 ' help colors
  90.     fgb = 4: bgb = 0                  ' box color
  91.     fgt = 3: bgt = 0                  ' text colors
  92.     ELSE
  93.     fg = 7: bg = 0
  94.     fge = 15: bge = 0
  95.     fgw = 0: bgw = 7
  96.     fgd = 15: bgd = 0
  97.     fgh = 7: bgh = 15
  98.     fgb = 15: bgb = 0
  99.     fgt = 7: bgt = 0
  100.     END IF
  101.  
  102.     eattr = (bge * 16) + fge              ' error message attributes
  103.     wattr = (bgw * 16) + fgw              ' window attributes
  104.     hattr = (bgh * 16) + fgh              ' help window attributes
  105.  
  106.     CALL WShadow(1)
  107.  
  108.     Adding = 0
  109.  
  110.     REM $DYNAMIC
  111.     REDIM Sarry(4000)                     ' dimension screen array for 2 screens
  112.  
  113.  
  114.     DIM hlp$(10)      ' String array to hold help screen msgs for use later.
  115.                   ' Has to be DIMmed in code prior to other references
  116.                   ' to hlp$().
  117.  
  118.     hlp$(1) = "Home - Start of line             End - End of line"
  119.     hlp$(2) = "  "
  120.     hlp$(3) = "Ctrl-X  Clear Field      Ctrl-End  Clear to end of line"
  121.     hlp$(4) = "Ctrl-U  Undo             <Arrows> Fwd, Bkwd 1 field "
  122.     hlp$(5) = "  "
  123.     hlp$(6) = "       PgUp / Ctrl PgUp - Jump to first field "
  124.     hlp$(7) = "       PgDn / Ctrl PgDn - Jump to last field  "
  125.     hlp$(8) = "  "
  126.     hlp$(9) = "[Esc] or [F9] Aborts Current Edit      [F10] Save Record"
  127.  
  128.     hlp$(10) = "[ Tap any key to continue ]"
  129.  
  130.  
  131.  
  132. prg.start:              '*************** start of program  *****************
  133.     GOSUB GenDisp                        ' put screen mask on screen
  134.     CALL SaveScrn(Sarry(1))                ' save it - RSTSCRN is quicker next time
  135.  
  136.     GOSUB OpenFil                        ' open the file
  137.  
  138.     IF hi = 0 THEN                       ' in case you lost the EMP.DAT file
  139.        GOSUB newfil
  140.     END IF
  141.     recno = hi                           ' get the top rec no
  142.  
  143.     GOSUB RecDisp                        ' display given record
  144.  
  145.  
  146. '----------------------------------------------------------------------------
  147. '  This is one big loop with several SELECT CASE constructs in it.
  148. '
  149. '  One CASE construct sets the level or a pointer to the field that we
  150. '  are currently editing.
  151. '
  152. '  Based on that level, another CASE construct sets the FED parameters
  153. '  for the next call.  ie if we are on level 2 (phone), then we need to
  154. '  set nums ON.
  155. '
  156. '  One other CASE block intercepts those fields that need further data
  157. '  verification and perfomrs that check.
  158. '
  159. '  The data is read from file into the TYPE structure and then stored
  160. '  in a string array for the level pointer indexing, then stored BACK
  161. '  to the TYPE structure for saving to disk.  You should not perform
  162. '  I/O directly on TYPE elements.
  163.  
  164. '  The random access file code contained here is pretty minimal - just
  165. '  enough to be able to demo FED.    In a "real" random file application,
  166. '  there are a number of things that should be done in the way of checking
  167. '  for valid data, also, there are  functions missing like to delete a
  168. '  record (missing because it does not lend itself to demoing FED or GLIB
  169. '  - this is not a QB tutor!).
  170. '  There ARE several other GLIB functions used:
  171. '  ERRMSG, DLRFRMAT, NFRMAT, WDW and a few others.
  172. '---------------------------------------------------------------------------
  173.  
  174.     level = 1                           ' indicates active FIELD in record
  175.     fsiz = 25                 ' first field siz
  176.     rx = 4                    ' input location
  177.     ry = 10
  178.     Alarm = 1                 ' beeper on
  179.     done = 0
  180.     REDIM Macro$(1)
  181.  
  182.     DO
  183.     LOCATE rx, ry                   ' locate current location
  184.     PRINT a$(level)                 ' print string
  185.     LOCATE rx, ry                   ' reset to SOS
  186.  
  187.     FCode = MFed(a$(level), fsiz, Macro$())
  188.     ' first, we want to intercept the 2 numeric inputs and
  189.     ' check them.  All validity checking would go here.
  190.  
  191.     SELECT CASE level
  192.         CASE 2                    ' check the phone
  193.         temp$ = a$(2)
  194.  
  195.         DO
  196.             m = 1: p = 0          ' m sets NFRMAT mode, p is useless here
  197.             errc = NFrmat(temp$, m, p)
  198.             IF m <> 1 THEN         '  something went wrong !!
  199.             ' tell them of error
  200.             CALL ERRMSG(temp$, 24, eattr%, 2)
  201.             temp$ = a$(2)
  202.             LOCATE rx, ry
  203.             FCode = MFed(a$(level), fsiz, Macro$())
  204.             END IF
  205.         LOOP UNTIL m = 1
  206.         a$(2) = temp$
  207.  
  208.         CASE 9
  209.         IF INSTR("HS", a$(9)) = 0 THEN
  210.             CALL ERRMSG("Pay Frequency code must be H or S only.", 24, eattr%, 2)
  211.             ret$ = " "
  212.             CALL GetCH("HS", ret$)   ' mask the input
  213.             a$(9) = ret$
  214.         END IF
  215.  
  216.         CASE 10
  217.         temp$ = a$(10)
  218.         DO
  219.             m = 0: p = 2        ' set up for dollar formatting call
  220.             errc = DlrFrmat(temp$, m%, p%)
  221.  
  222.             IF m <> 0 THEN                   ' if m is changed
  223.             CALL ERRMSG(temp$, 24, eattr, 2)
  224.             temp$ = a$(10)
  225.             LOCATE rx, ry
  226.             FCode = MFed(temp$, fsiz, Macro$())
  227.             END IF
  228.         LOOP UNTIL m = 0
  229.  
  230.         CASE ELSE
  231.     END SELECT
  232.  
  233.  
  234.  
  235.     SELECT CASE FCode                ' handle the exit return first
  236.         CASE 0, 2                    ' down = enter for this
  237.         level = level + 1
  238.  
  239.         ' "wrap" from last to first field
  240.         IF level > UBOUND(a$) THEN level = 1
  241.  
  242.  
  243.         CASE 1                       ' UP
  244.         IF level - 1 > 0 THEN
  245.             level = level - 1
  246.         END IF
  247.  
  248.         CASE 11                        ' F1 key pressed (HELP)
  249.         CALL SaveScrn(Sarry(2001))         ' save screen as is
  250.         CALL wdw(7, 12, 17, 72, 1, 1, 2, hattr, "Editting Help")
  251.  
  252.         FOR x = 1 TO 9                   ' pop help window up
  253.             CALL QPrint(hlp$(x), 7 + x, 14, hattr%)
  254.         NEXT x                           ' QUIKPRT help